home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
050
/
popscren.arc
/
POPSCREN.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1986-05-03
|
6KB
|
169 lines
{@@@@@@@@@@@ copyright (C) 1984 by Neil J. Rubenking @@@@@@@@@@@@@@@@@@@@@@@@
The purchaser of these procedures and functions may include them in COMPILED
programs freely, but may not sell or give away the source text.
A variable type is declared in SCREENS.TYP that is the same "shape"
as the (text) screen memory. Using the "absolute" clause we
can define variables "MONO" and "COLO" that exist "on top of" the
Monochrome and Color screen memories. If we then switch in some
other SCREEN variable (e.g., "Mono := new_screen"), the whole
video display changes instantly.
The procedure MAKESCREEN takes a line of text and converts it into
one line of a screen variable. You can get a screen into memory by
reading it from a file (see GetScreensFromFile below), by using
MAKESCREEN on text constants (see CreateAScreen below), or by
"grabbing" it from the screen memory itself (see GrabScreen below).
One possible application for this sort of screen manipulation is
a POP-out menu. Your program can "grab" the current screen, write
the menu onto the display, and then restore the screen.
}
{$I screens.typ}
{$I popscren.lib}
{$I monitor.lib}
{$I getkeys.lib}
{$I grfxtabl.lib}
{$I titles.lib}
var
Pops : array[1..5] of screen;
N, M : byte;
PopFile : text;
OneLine : lineType;
C, D : char;
Your_title : title_type;
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
procedure GetScreensFromFile;
{This is one way to put screens into memory}
begin
Assign(PopFile,'POPSCREN.DAT');
reset(PopFile);
N := 0;
while (not EOF(PopFile)) and (N < 25) do
begin
N := N + 1;
readLn(PopFile,OneLine);
MakeScreen(Pops[1][N],15,OneLine);
MakeScreen(Pops[2][N],112,OneLine);
MakeScreen(Pops[3][N],1,OneLine);
end;
close(PopFile);
end;
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
procedure CreateAScreen;
{This is another way to create a screen}
begin
MakeScreen(Pops[4][1],15,'');
MakeScreen(Pops[4][2],15,'');
MakeScreen(Pops[4][3],15,'');
MakeScreen(Pops[4][4],15,'');
MakeScreen(Pops[4][5],15,
'THIS SCREEN WAS NOT READ FROM THAT FILE.');
MakeScreen(Pops[4][6],15,
' THIS SCREEN WAS NOT READ FROM THAT FILE.');
MakeScreen(Pops[4][7],15,
' THIS SCREEN WAS NOT READ FROM THAT FILE.');
MakeScreen(Pops[4][8],15,
' THIS SCREEN WAS NOT READ FROM THAT FILE.');
MakeScreen(Pops[4][9],15,
' THIS SCREEN WAS NOT READ FROM THAT FILE.');
MakeScreen(Pops[4][10],15,
' THIS SCREEN WAS NOT READ FROM THAT FILE.');
MakeScreen(Pops[4][11],15,
' THIS SCREEN WAS NOT READ FROM THAT FILE.');
MakeScreen(Pops[4][12],15,
' THIS SCREEN WAS NOT READ FROM THAT FILE.');
MakeScreen(Pops[4][13],15,
' THIS SCREEN WAS NOT READ FROM THAT FILE.');
MakeScreen(Pops[4][14],15,
' THIS SCREEN WAS NOT READ FROM THAT FILE.');
MakeScreen(Pops[4][15],15,
' THIS SCREEN WAS NOT READ FROM THAT FILE.');
MakeScreen(Pops[4][16],15,
' THIS SCREEN WAS NOT READ FROM THAT FILE.');
MakeScreen(Pops[4][17],15,
' THIS SCREEN WAS NOT READ FROM THAT FILE.');
MakeScreen(Pops[4][18],15,
' THIS SCREEN WAS NOT READ FROM THAT FILE.');
for N := 19 to 25 do
MakeScreen(Pops[4][N],15,'');
end;
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
procedure GrabScreen; {Here we "grab" a screen from the actual display}
begin
WRite('Enter a word of 10 letters or less: ');
ReadLn(your_title);
ClrScr;
MakeTitle(your_title,1);
MakeTitle(your_title,9);
MakeTitle(your_title,17);
if color then Pops[5] := Colo
else Pops[5] := Mono;
ClrScr;
end;
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
procedure MenuDemo;
begin
for N := 1 to 5 do
begin
WriteLn('Now to fill the screen with text, in preparation for a');
WriteLn('demonstration of a pop-out menu. Pressing a key saves');
WriteLn('the current screen & shows the menu.');
WriteLn;
end;
repeat
GetKeys(C,D);
if ((C = #27) and (D = ';')) then
begin
Mono := Pops[5];
Colo := Pops[5];
end
else
begin
if color then Pops[5] := Colo
else Pops[5] := Mono;
TextColor(black);TextBackground(white);
GotoXY(20,5);Write ('╔══════════════════════════════╗');
GotoXY(20,6);Write ('║ ║');
GotoXY(20,7);Write ('║ This might well be a menu. ║');
GotoXY(20,8);Write ('║ Press F1 to restore the ║');
GotoXY(20,9);Write ('║ screen, F2 to end ║');
GotoXY(20,10);Write('║ ║');
GotoXY(20,11);Write('╚══════════════════════════════╝');
TextColor(white);TextBackground(black);
end;
until (C = #27) and (D = '<');
end;
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
begin
WriteLn('This is a demonstration of directly writing WHOLE SCREENS to the');
WriteLn('display. First, a "picture" screen is read from disk in three');
WriteLn('different colors. Next a screen is created directly within this');
WriteLn('program. Finally, a screen is created on the display and "grabbed"');
WriteLn('by the program.');
WriteLn('After all that, you get a demo of a SCREEN menu.');
WriteLn('Press a key to start it all');
repeat until keypressed;
CheckColor;
GetScreensFromFile;
CreateAScreen;
GrabScreen;
GotoXY(2,2); write('Keep pressing a key for a quick change of screen.');
Write('<Esc> to go on.');
N := 0;
repeat
GetKeys(C,D);
N := N + 1;
Mono := Pops[(N mod 5) + 1];
Colo := Pops[(N mod 5) + 1];
until (C = #27) and (D = #0);
ClrScr;
MenuDemo;
ClrScr;
end.